Simplify finding and matching replacements
authorJustin Burkett <justin@burkett.cc>
Mon, 25 Feb 2019 03:57:31 +0000 (22:57 -0500)
committerJustin Burkett <justin@burkett.cc>
Mon, 25 Feb 2019 03:57:31 +0000 (22:57 -0500)
Don't try to grab all matching replacements ahead of time, because later ones
may not match if earlier ones make deletions.

Fixes #202

which-key.el

index 6661f76bc0b4eabd8fa22ea83dbaa8e97203d20e..21d159a448db76b34665e5243c57e4fdba473eeb 100644 (file)
@@ -1401,29 +1401,18 @@ local bindings coming first. Within these categories order using
 (defsubst which-key--butlast-string (str)
   (mapconcat #'identity (butlast (split-string str)) " "))
 
-(defun which-key--get-replacements (key-binding &optional use-major-mode)
-  (let ((alist (or (and use-major-mode
-                        (cdr-safe
-                         (assq major-mode which-key-replacement-alist)))
-                   which-key-replacement-alist))
-        res case-fold-search)
-    (catch 'res
-      (dolist (replacement alist)
-        ;; these are mode specific ones to ignore. The mode specific case is
-        ;; handled in the selection of alist
-        (unless (symbolp (car replacement))
-          (let ((key-regexp (caar replacement))
-                (binding-regexp (cdar replacement)))
-            (when (and (or (null key-regexp)
-                           (string-match-p key-regexp
-                                           (car key-binding)))
-                       (or (null binding-regexp)
-                           (string-match-p binding-regexp
-                                           (cdr key-binding))))
-              (push replacement res)
-              (when (not which-key-allow-multiple-replacements)
-                (throw 'res res)))))))
-    (nreverse res)))
+(defun which-key--match-replacement (key-binding replacement)
+  ;; these are mode specific ones to ignore. The mode specific case is
+  ;; handled in the selection of alist
+  (when (and (consp key-binding) (not (symbolp (car replacement))))
+    (let ((key-regexp (caar replacement))
+          (binding-regexp (cdar replacement)))
+      (and (or (null key-regexp)
+               (string-match-p key-regexp
+                               (car key-binding)))
+           (or (null binding-regexp)
+               (string-match-p binding-regexp
+                               (cdr key-binding)))))))
 
 (defun which-key--get-pseudo-binding (key-binding &optional prefix)
   (let* ((pseudo-binding
@@ -1444,30 +1433,35 @@ local bindings coming first. Within these categories order using
   "Use `which-key--replacement-alist' to maybe replace KEY-BINDING.
 KEY-BINDING is a cons cell of the form \(KEY . BINDING\) each of
 which are strings. KEY is of the form produced by `key-binding'."
-  (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix)))
+  (let* ((pseudo-binding (which-key--get-pseudo-binding key-binding prefix))
+         one-match)
     (if pseudo-binding
         pseudo-binding
-      (let* ((mode-res (which-key--get-replacements key-binding t))
-             (all-repls (or mode-res
-                            (which-key--get-replacements key-binding))))
+      (let* ((all-repls (or (cdr-safe
+                             (assq major-mode which-key-replacement-alist))
+                            which-key-replacement-alist)))
         (dolist (repl all-repls key-binding)
-          (setq key-binding
-                (cond ((or (not (consp repl)) (null (cdr repl)))
-                       key-binding)
-                      ((functionp (cdr repl))
-                       (funcall (cdr repl) key-binding))
-                      ((consp (cdr repl))
-                       (cons
-                        (cond ((and (caar repl) (cadr repl))
-                               (replace-regexp-in-string
-                                (caar repl) (cadr repl) (car key-binding) t))
-                              ((cadr repl) (cadr repl))
-                              (t (car key-binding)))
-                        (cond ((and (cdar repl) (cddr repl))
-                               (replace-regexp-in-string
-                                (cdar repl) (cddr repl) (cdr key-binding) t))
-                              ((cddr repl) (cddr repl))
-                              (t (cdr key-binding))))))))))))
+          (when (and (or which-key-allow-multiple-replacements
+                         (not one-match))
+                     (which-key--match-replacement key-binding repl))
+            (setq one-match t)
+            (setq key-binding
+                  (cond ((or (not (consp repl)) (null (cdr repl)))
+                         key-binding)
+                        ((functionp (cdr repl))
+                         (funcall (cdr repl) key-binding))
+                        ((consp (cdr repl))
+                         (cons
+                          (cond ((and (caar repl) (cadr repl))
+                                 (replace-regexp-in-string
+                                  (caar repl) (cadr repl) (car key-binding) t))
+                                ((cadr repl) (cadr repl))
+                                (t (car key-binding)))
+                          (cond ((and (cdar repl) (cddr repl))
+                                 (replace-regexp-in-string
+                                  (cdar repl) (cddr repl) (cdr key-binding) t))
+                                ((cddr repl) (cddr repl))
+                                (t (cdr key-binding)))))))))))))
 
 (defsubst which-key--current-key-list (&optional key-str)
   (append (listify-key-sequence (which-key--current-prefix))